This is an interactive leaflet containing NYC specific data on NYC public schools, Social Vulnerability, Child Opportunity, COVID19 and County/Census/Zip geographic boundaries.
There are 486 census tracts in NYC identified as likely to be impacted by COVID19 based on high vulnerability and low child opportunity. This table can be output into CSV, Excel or PDF format.
There are 313 NYC schools identified in the 124 relevant neighborhoods (identified through the 486 census tracts likely to be impacted by COVID19). As mentioned, schools were used here as a potential means of (1) identifying high MH need students, (2) planning for resource distribution, and (3) establishing a starting point in assessing the surrounding community needs. This table can be output into CSV, Excel or PDF format.
---
title: "Assessment of Social Vulnerability and Child Opportunity in NYC in the context of COVID19"
output:
flexdashboard::flex_dashboard:
storyboard: true
source: embed
---
```{r setup, include=FALSE, cache=TRUE}
# Load packages
library(dplyr) # data manipulation
library(reshape) # data manipulation
library(tidyverse) # data manipulation
library(DescTools) # data manipulation
library(tigris) # geospatial data
library(sp) # visualization
library(htmlwidgets) # interactive widgets
library(DT) # interactive table
library(leaflet) # visualization
library(ggplot2) # visualization
library(flexdashboard) # visualization
library(ggpubr) # visualization
schools <- readRDS(file = "rds_files/schools.rds")
merge_opp <- readRDS(file = "rds_files/merge_opp.rds")
nyc_covid <- readRDS(file = "rds_files/nyc_covid.rds")
nyc_zips <- readRDS(file = "rds_files/nyc_zips.rds")
county_sp <- readRDS(file = "rds_files/county_sp.rds")
svi_tracts <- readRDS(file = "rds_files/svi_tracts.rds")
ds_svi <- readRDS(file = "rds_files/ds_svi.rds")
svi_opp <- readRDS(file = "rds_files/svi_opp.rds")
school_tracts <- readRDS(file = "rds_files/school_tracts.rds")
```
### Interactive Leaflet of SVI, COI, COVID, and Geo boundaries in NYC
```{r, cache=TRUE}
# Layer 1 - COVID by ZIP options
popup1 <- paste0("Zip Code: ", nyc_covid$ZCTA5CE10, "
", "Percent Positive Cases: ", nyc_covid$zcta_cum.perc_pos)
pal1 <- colorNumeric(palette = "YlGnBu", domain= nyc_covid$zcta_cum.perc_pos)
# Layer 2 - SVI by Census Tract options
popup2 <- paste0("GEOID: ", svi_tracts$GEOID, "
", "Social Vulnerability Index: ", svi_tracts$RPL_THEMES,"
", "COUNTY: ", svi_tracts$COUNTY)
pal2 <- colorFactor(palette = "YlGnBu", domain = svi_tracts$cat)
# Layer 3 - Child Opportunity Index
popup3 <- paste0("GEOID: ", merge_opp$GEOID, "
", "Child Opportunity Level: ", merge_opp$c5_COI_nat,"
", "COUNTY: ", merge_opp$msaname15)
pal3 <- colorFactor(palette = "YlGnBu", domain = merge_opp$c5_COI_nat, reverse = TRUE)
# Layer 4 - SMH Layer
popup4 <- paste0("School Name: ", schools$location_name, "
","DBN: ", schools$system_code, "
","Address: ", schools$primary_address_line_1)
# Label Text
labels1 <- sprintf( # label for covid by zip code
"Zip code: %s
Perc. Positive: %g",
nyc_covid$ZCTA5CE10, nyc_covid$zcta_cum.perc_pos
) %>% lapply(htmltools::HTML)
labels2 <- sprintf( # label for zip codes
"Zip code: %s",
nyc_zips$ZCTA5CE10) %>% lapply(htmltools::HTML)
labels3 <- sprintf( # label for county names
"County: %s",
county_sp$NAME) %>% lapply(htmltools::HTML)
labels4 <- sprintf( # label for school names
"School Name: %s",
schools$location_name) %>% lapply(htmltools::HTML)
# label parameters
label_Options <- labelOptions(style = list("font-weight" = "normal", padding = "3px 8px"), textsize = "15px", direction = "auto")
# highlight parameters
highlight_Options <- highlightOptions(color = "white", weight = 2, fillOpacity = 0.9, bringToFront = TRUE)
highlight_Options2 <- highlightOptions(color = "white", weight = 2, bringToFront = TRUE)
p <- leaflet() %>%
# Base Groups
addProviderTiles("CartoDB.Positron", group = "Positron") %>%
addTiles(urlTemplate = "http://mt0.google.com/vt/lyrs=m&hl=en&x={x}&y={y}&z={z}&s=Ga",
attribution = 'Google', group = "Google Map") %>%
addTiles(group = "default") %>%
addProviderTiles(providers$Stamen.TonerLite, group = "Toner Lite") %>%
# Overlay Groups
addCircleMarkers(data=schools, # school layer
lat = schools$latitude,
lng = schools$longitude,
weight = 2,
radius = 2,
stroke = FALSE,
color = "black",
fillOpacity = 1.0,
label = labels4,
popup = popup4,
group = "NYC Schools") %>%
addPolygons(data = nyc_covid, # NYC ZIPS + COVID19 % Positive
fillColor = ~pal1(zcta_cum.perc_pos),
weight =2,
color = "black",
fillOpacity = 0.7,
popup = popup1,
label = labels1,
labelOptions = label_Options,
highlightOptions = highlight_Options,
group = "COVID19 % Positive") %>%
addPolygons(data = svi_tracts, # SVI by Census Tracts
fillColor = ~pal2(cat),
color = "black",
fillOpacity = 0.5,
weight = 1,
smoothFactor = 0.2,
popup = popup2,
highlightOptions = highlight_Options,
group = "Social Vulnerability Index") %>%
addPolygons(data = merge_opp, # Child Opportunity Index by Census Tracts
fillColor = ~pal3(c5_COI_nat),
color = "#b2aeae",
fillOpacity = 0.6,
weight = 1,
smoothFactor = 0.2,
popup = popup3,
highlightOptions = highlight_Options,
group = "Child Opportunity Index") %>%
addPolygons(data = nyc_zips, # NYC Zip Codes
weight =2,
color= "blue",
fillOpacity = 0,
label = labels2,
labelOptions = label_Options,
highlightOptions = highlight_Options2,
group = "zips") %>%
addPolygons(data = county_sp, # NY County Boundaries
color = "orange",
fillOpacity = 0,
weight = 3,
label = labels3,
labelOptions = label_Options,
highlightOptions = highlight_Options2,
group = "county") %>%
setView(lng = "-73.935242", lat = "40.730610", zoom = 10) %>%
# Layers control
addLayersControl(
baseGroups = c("Positron","Google Map", "default", "Toner Lite"),
overlayGroups = c("NYC Schools", "COVID19 % Positive", "Social Vulnerability Index", "Child Opportunity Index", "zips", "county"),
options = layersControlOptions(collapsed = FALSE)
) %>%
addLegend(pal = pal1,
values = nyc_covid$zcta_cum.perc_pos,
position = "bottomleft",
title = "Percent Positive",
labFormat = labelFormat(suffix = "%"),
group = "COVID19 % Positive") %>%
addLegend(pal = pal2,
values = svi_tracts$cat,
position = "bottomright",
title = "Social Vulnerability Index",
group = "Social Vulnerability Index") %>%
addLegend(pal = pal3,
values = merge_opp$c5_COI_nat,
position = "topright",
title = "Child Opp",
group = "Child Opportunity Index") %>%
hideGroup(c("COVID19 % Positive", "Child Opportunity Index", "zips", "county", "NYC Schools" ))
p
```
***
This is an interactive leaflet containing NYC specific data on NYC public schools, Social Vulnerability, Child Opportunity, COVID19 and County/Census/Zip geographic boundaries.
- Positron, google map, default, and Toner lite are different choices of basemap.
- COVID, SVI, and COI layers are best viewed one at a time. The overlay of multiple layers will not correspond to any defined color legends.
- The zips or actually zctas, a census modified zip code, can be used with the SVI and COI layers to get a sense of "zip" boundaries.
- The county layer can be used with any layer to get a sense of county boundaries.
- NYC schools were added as a potential means of (1) identifying high MH need students, (2) planning for resource distribution, and (3) establishing a starting point in assessing the surrounding community needs.
### Census Tracts likely to be impacted by COVID19
```{r}
# convert borough to cnty code
schools$STCNY[substr(schools$system_code, 3, 3) == "K"] <- "36047" # Kings
schools$STCNY[substr(schools$system_code, 3, 3) == "X"] <- "36005" # Bronx
schools$STCNY[substr(schools$system_code, 3, 3) == "Q"] <- "36081" # Queens
schools$STCNY[substr(schools$system_code, 3, 3) == "M"] <- "36061" # New York
schools$STCNY[substr(schools$system_code, 3, 3) == "R"] <- "36085" # Richmond
# priority list of census tracts very low opportunity, highest vulnerability
priority_list <- svi_opp %>%
filter(c5_COI_nat == "Very Low" & cat == "Highest Vulnerability") %>% arrange(COUNTY)
datatable(priority_list[c(1:6)], extensions = 'Buttons', options = list(dom = 'Bfrtip',buttons = list(extend = 'collection', buttons = c('csv', 'excel', 'pdf'), text = 'Download')))
```
***
There are 486 census tracts in NYC identified as likely to be impacted by COVID19 based on high vulnerability and low child opportunity. This table can be output into CSV, Excel or PDF format.
### Neighborhoods matched w/open NYC public schools of regions likely to be impacted by COVID19
```{r}
# schools that matched priority list census tracts n = 313 schools
priority_dbn <- left_join(priority_list, school_tracts, by = "GEOID")
priority_dbn_table <- priority_dbn %>%
group_by(nta_name) %>%
summarize(system_code = paste(unique(system_code), collapse = ', '))
datatable(priority_dbn_table, extensions = 'Buttons', options = list(dom = 'Bfrtip',buttons = list(extend = 'collection', buttons = c('csv', 'excel', 'pdf'), text = 'Download')))
```
***
There are 313 NYC schools identified in the 124 relevant neighborhoods (identified through the 486 census tracts likely to be impacted by COVID19). As mentioned, schools were used here as a potential means of (1) identifying high MH need students, (2) planning for resource distribution, and (3) establishing a starting point in assessing the surrounding community needs. This table can be output into CSV, Excel or PDF format.
```{r, eval = FALSE}
# convert borough to cnty code
schools$STCNY[substr(schools$system_code, 3, 3) == "K"] <- "36047" # Kings
schools$STCNY[substr(schools$system_code, 3, 3) == "X"] <- "36005" # Bronx
schools$STCNY[substr(schools$system_code, 3, 3) == "Q"] <- "36081" # Queens
schools$STCNY[substr(schools$system_code, 3, 3) == "M"] <- "36061" # New York
schools$STCNY[substr(schools$system_code, 3, 3) == "R"] <- "36085" # Richmond
# clean census tract var in schools
schools$census_tract <- sub("[.]", "", schools$census_tract)
# use str as sub for NA in corresponding census tract value
svi_tracts$LOCATION <- str_replace_all(svi_tracts$LOCATION, fixed(" "), "")
svi_opp$x <- substr(svi_tracts$LOCATION, 12, (StrPos(svi_tracts$LOCATION, ","))-1)
svi_opp$NAME.y <- ifelse(is.na(svi_opp$NAME.y), svi_opp$x, svi_opp$NAME.y)
svi_opp$NAME.y <- sub("[.]", "", svi_opp$NAME.y) # remove "." in svi_opp's abv tract
schools %>% select(system_code, community_district, borough_block_lot, ctny_cname) %>% arrange(ctny_cname)
svi_opp %>% group_by(ctny_cname) %>% filter(n()>1)
#school_tracts <- left_join(schools, svi_opp, by)
```